(FILECREATED "22-FEB-83 06:43:43" {PHYLUM}<GABRIEL>SFFT.;4 3714   

      changes to:  (VARS SFFTCOMS)
		   (FNS SFFT)

      previous date: "22-FEB-83 05:17:28" {PHYLUM}<GABRIEL>SFFT.;1)


(* Copyright (c) 1983 by JonL)

(PRETTYCOMPRINT SFFTCOMS)

(RPAQQ SFFTCOMS ((FNS SFFT)
		 (VARS (ARE (ARRAY 1025 (QUOTE POINTER)
				   0.0))
		       (AIM (ARRAY 1025 (QUOTE POINTER)
				   0.0)))
		 (MACROS IEXPT)))
(DEFINEQ

(SFFT
  (LAMBDA (AREAL AIMAG)                                      (* JonL "22-FEB-83 05:25")
                                                             (* Fast Fourier Transform AREAL = real part AIMAG = 
							     imaginary part)
    (PROG (AR AI PI I J K M N LE LE1 IP NV2 NM1 UR UI WR WI TR TI)
          (SETQ AR AREAL)                                    (* Initialize)
          (SETQ AI AIMAG)
          (SETQ PI 3.141593)
          (SETQ N (ARRAYSIZE AR))
          (add N -1)
          (SETQ NV2 (LRSH N 1))
          (SETQ NM1 (SUB1 N))
          (SETQ M 0)
          (SETQ I 1)
      L1  (until (NOT (ILESSP I N))
	     do                                              (* Compute M = log (N))
		(add M 1)
		(add I I))
          (if (NOT (IEQP N (IEXPT 2 M)))
	      then (PRINC "Error ... array size not a power of two.")
		   (READ)
		   (RETURN (TERPRI)))
          (SETQ J 1)                                         (* ;Interchange elements)
          (SETQ I 1)                                         (* ;in bit-reversed order)
      L3  (repeatuntil (NOT (ILESSP I N))
	     do (if (ILESSP I J)
		    then (SETQ TR (ELT AR J))
			 (SETQ TI (ELT AI J))
			 (SETA AR J (ELT AR I))
			 (SETA AI J (ELT AI I))
			 (SETA AR I TR)
			 (SETA AI I TI))
		(SETQ K NV2)
		L6
		(until (NOT (ILESSP K J))
		   do (SETQ J (IDIFFERENCE J K))
		      (SETQ K (LRSH K 1)))
		(SETQ J (IPLUS J K))
		(add I 1))
          (for L to M
	     do                                              (* ;Loop thru stages)
		(SETQ LE (IEXPT 2 L))
		(SETQ LE1 (LRSH LE 1))
		(SETQ UR 1.0)
		(SETQ UI 0.0)
		(SETQ WR (COS (FQUOTIENT PI (FLOAT LE1))))
		(SETQ WI (SIN (FQUOTIENT PI (FLOAT LE1))))
		(for J to LE1
		   do                                        (* ;Loop thru butterflies)
		      (for I from J by LE until (IGREATERP I N)
			 do                                  (* ;Do a butterfly)
			    (SETQ IP (IPLUS I LE1))
			    (SETQ TR (FDIFFERENCE (FTIMES (ELT AR IP)
							  UR)
						  (FTIMES (ELT AI IP)
							  UI)))
			    (SETQ TI (FPLUS (FTIMES (ELT AR IP)
						    UI)
					    (FTIMES (ELT AI IP)
						    UR)))
			    (SETA AR IP (FDIFFERENCE (ELT AR I)
						     TR))
			    (SETA AI IP (FDIFFERENCE (ELT AI I)
						     TI))
			    (SETA AR I (FPLUS (ELT AR I)
					      TR))
			    (SETA AI I (FPLUS (ELT AI I)
					      TI)))
		      (SETQ TR (FDIFFERENCE (FTIMES UR WR)
					    (FTIMES UI WI)))
		      (SETQ TI (FPLUS (FTIMES UR WI)
				      (FTIMES UI WR)))
		      (SETQ UR TR)
		      (SETQ UI TI)))
          (RETURN T))))
)

(RPAQ ARE (ARRAY 1025 (QUOTE POINTER)
		 0.0))

(RPAQ AIM (ARRAY 1025 (QUOTE POINTER)
		 0.0))
(DECLARE: EVAL@COMPILE 

(PUTPROPS IEXPT MACRO (X
  (PROG ((N (CAR (CONSTANTEXPRESSIONP (CAR X))))
	 (E (CADR X)))
        (RETURN (if (AND (FIXP N)
			 (POWEROFTWOP N))
		    then (if (NEQ 2 N)
			     then (SETQ E (BQUOTE (ITIMES , (SUB1 (INTEGERLENGTH N))
							  ,E))))
			 (BQUOTE (MASK.1'S , E 1))
		  else (BQUOTE (EXPT (IPLUS 0 , (CAR X))
				     (IPLUS 0 , (CADR X)))))))))
)
(PUTPROPS SFFT COPYRIGHT ("JonL" 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (416 3135 (SFFT 426 . 3133)))))
STOP